;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Copyright 2021 fanguangping
; 
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
; 
;     http://www.apache.org/licenses/LICENSE-2.0
; 
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#lang racket

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Stack class
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require "../common/constants.scm")
(require "../common/messages.scm")
(require "../common/utils.scm")
(require "Object.scm")

(provide (all-defined-out))

(define (mix-comparator type comparator)
  (cond
    ((equal? type 'string)
     (cond
       ((equal? comparator '<?) string<?)
       ((equal? comparator '<=?) string<=?)
       ((equal? comparator '=?) string=?)
       ((equal? comparator '>?) string>?)
       ((equal? comparator '>=?) string>=?)
       (else +nil+)))
    ((equal? type 'symbol)
     (cond
       ((equal? comparator '<?) (lambda (a b) (string<? (symbol->string a) (symbol->string b))))
       ((equal? comparator '<=?) (lambda (a b) (string<=? (symbol->string a) (symbol->string b))))
       ((equal? comparator '=?) symbol=?)
       ((equal? comparator '>?) (lambda (a b) (string>? (symbol->string a) (symbol->string b))))
       ((equal? comparator '>=?) (lambda (a b) (string>=? (symbol->string a) (symbol->string b))))
       (else +nil+)))
    ((equal? type 'number)
     (cond
       ((equal? comparator '<?) <)
       ((equal? comparator '<=?) <=)
       ((equal? comparator '=?) =)
       ((equal? comparator '>?) >)
       ((equal? comparator '>=?) >=)
       (else +nil+)))
    ((equal? type 'pair)
     (cond
       ((equal? comparator '<?)
        (lambda (a b)
          (cond
            ((and (null? a) (null? b)) +false+)
            ((and (null? a) (not-null? b)) +true+)
            ((and (not-null? a) (null? b)) +false+)
            (else (mix<? (car a) (car b))))))
       ((equal? comparator '<=?)
        (lambda (a b)
          (cond
            ((and (null? a) (null? b)) +true+)
            ((and (null? a) (not-null? b)) +true+)
            ((and (not-null? a) (null? b)) +false+)
            (else (mix<=? (car a) (car b))))))
       ((equal? comparator '=?)
        (lambda (a b)
          (cond
            ((and (null? a) (null? b)) +true+)
            ((and (null? a) (not-null? b)) +false+)
            ((and (not-null? a) (null? b)) +false+)
            (else (mix=? (car a) (car b))))))
       ((equal? comparator '>?)
        (lambda (a b)
          (cond
            ((and (null? a) (null? b)) +false+)
            ((and (null? a) (not-null? b)) +false+)
            ((and (not-null? a) (null? b)) +true+)
            (else (mix>? (car a) (car b))))))
       ((equal? comparator '>=?)
        (lambda (a b)
          (cond
            ((and (null? a) (null? b)) +true+)
            ((and (null? a) (not-null? b)) +false+)
            ((and (not-null? a) (null? b)) +true+)
            (else (mix>=? (car a) (car b))))))
       (else +nil+)))
    ((equal? type 'character)
     (cond
       ((equal? comparator '<?) char<?)
       ((equal? comparator '<=?) char<=?)
       ((equal? comparator '=?) char=?)
       ((equal? comparator '>?) char>?)
       ((equal? comparator '>=?) char>=?)
       (else +nil+)))
    ((equal? type 'boolean)
     (cond
       ((equal? comparator '<?) (lambda (a b) (and (equal? a +false+) (equal? b +true+))))
       ((equal? comparator '<=?) (lambda (a b) (equal? a +false+)))
       ((equal? comparator '=?) equal?)
       ((equal? comparator '>?) (lambda (a b) (and (equal? a +true+) (equal? b +false+))))
       ((equal? comparator '>=?) (lambda (a b) (equal? a +true+)))
       (else +nil+)))
    (else +nil+)))

(define (type<? typeA typeB)
  (define type-precedence
    '((string . 1)
      (symbol . 2)
      (number . 3)
      (pair . 4)
      (character . 5)
      (boolean . 6)))
  (< (assoc-value type-precedence typeA) (assoc-value type-precedence typeB)))

(define (mix<? a b)
  (define typeA (object-type a))
  (define typeB (object-type b))
  (cond
    ((type<? typeA typeB) +true+)
    ((equal? typeA typeB) ((mix-comparator typeA '<?) a b))
    (else +false+)))

(define (mix=? a b)
  (define typeA (object-type a))
  (define typeB (object-type b))
  (and (equal? typeA typeB) ((mix-comparator typeA '=?) a b)))

(define (mix>? a b)
  (not (mix<=? a b)))

(define (mix<=? a b)
  (or (mix<? a b) (mix=? a b)))

(define (mix>=? a b)
  (not (mix<? a b)))
